home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tix8.1 / Init.tcl < prev    next >
Text File  |  2002-12-01  |  6KB  |  178 lines

  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: Init.tcl,v 1.3.2.6 2002/12/02 04:02:51 idiscovery Exp $
  4. #
  5. # Init.tcl --
  6. #
  7. #    Initializes the Tix library and performes version checking to ensure
  8. #    the Tcl, Tk and Tix script libraries loaded matches with the binary
  9. #    of the respective packages.
  10. #
  11. # Copyright (c) 1993-1999 Ioi Kim Lam.
  12. # Copyright (c) 2000-2001 Tix Project Group.
  13. #
  14. # See the file "license.terms" for information on usage and redistribution
  15. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  16. #
  17.  
  18. global tix_library
  19. if {![info exists tix_library]} {
  20.     set msg "Unable to find the Tix library directory TIX_LIBRARY"
  21.     append msg "This probably means that Tix wasn't installed properly."
  22.     error $msg
  23. }
  24. global auto_path
  25. if {![tixStrEq $tix_library ""]} {
  26.     lappend auto_path $tix_library [file join  $tix_library pref]
  27. }
  28. lappend auto_path [file dir [info name]]
  29.  
  30. proc __tixError {errorMsg} {
  31.     error [concat $errorMsg \
  32.        "Please check your TIX_LIBRARY environment variable and " \
  33.        "your Tix installation."]
  34. }
  35.  
  36. proc __tixInit {} {
  37.     global tix tixPriv env tix_version tix_patchLevel tk_version tix_library
  38.     global tcl_version
  39.  
  40.     if {[info exists tix(initialized)]} {
  41.     return
  42.     }
  43.     if {[info command "@scope"] != ""} {
  44.     set hasItcl 1
  45.     } else {
  46.     set hasItcl 0
  47.     }
  48.  
  49.     # STEP 0: Version checking using the Tcl7.5 package mechanism. This is not
  50.     #          done if we are linked to Tcl 7.4.
  51.     #
  52.     if {[string compare [info command package] ""]} {
  53.     if {![string comp [info command tixScriptVersion] ""] && 
  54.         ![auto_load tixScriptVersion]} {
  55.         __tixError [concat "Cannot determine version of Tix script " \
  56.         "library. Requires version $tix_version."]
  57.     }
  58.  
  59.     if {!$hasItcl} {
  60.         set pkgVersion  $tix_version.$tcl_version
  61.     } else {
  62.         # The extra .1 indicates that the Tix binary is specially
  63.         # compiled for Itcl. This is necessary for the "package
  64.         # require" command to load in the correct shared library
  65.         # file.
  66.         set pkgVersion  $tix_version.$tcl_version.1
  67.     }
  68.  
  69.     package provide Tix $pkgVersion
  70.     if {[tixStrEq $tix_library ""]} {
  71.         package provide Tixsam $pkgVersion
  72.     }
  73.     }
  74.  
  75.     # STEP 1: Version checking
  76.     #
  77.     #
  78.     package require -exact Tix $tix_version.$tcl_version
  79.  
  80.     # STEP 2: Initialize file compatibility modules
  81.     #
  82.     #
  83.     if {[info exists tixPriv(isWindows)]} {
  84.     tixInitFileCmpt:Win
  85.     } elseif {[info exists env(WINDOWS_EMU_DEBUG)]} {
  86.     tixInitFileCmpt:Win
  87.     tixWinFileEmu
  88.     } else {
  89.     tixInitFileCmpt:Unix
  90.     }
  91.  
  92.     # STEP 3: Initialize the Tix application context
  93.     #
  94.     #
  95.  
  96.     tixAppContext tix
  97.  
  98.     # STEP 4: Initialize the bindings for widgets that are implemented in C
  99.     #
  100.     #
  101.     if {[string compare [info command tixHList] ""]} {
  102.     tixHListBind
  103.     }
  104.     if {[string compare [info command tixTList] ""]} {
  105.     tixTListBind
  106.     }
  107.     if {[string compare [info command tixGrid]  ""]} {
  108.     tixGridBind
  109.     }
  110.     tixComboBoxBind
  111.     tixControlBind
  112.     tixFloatEntryBind
  113.     tixLabelEntryBind
  114.     tixScrolledGridBind
  115.     tixScrolledListBoxBind
  116.  
  117.     global tcl_platform tcl_interactive
  118.     if {$tcl_platform(platform) == "windows"} {
  119.     if {[info exists tcl_interactive] && !$tcl_interactive && \
  120.         [info exists env(TIX_CONSOLE)] && $env(TIX_CONSOLE) != "0"} {
  121.         # On Windows, initialize the console even if there is no script.
  122.         # The problem here is that frozen/wrapped exes never have a script.
  123.         # To invoke this,  simply set the environment variable TIX_CONSOLE
  124.         # to 1 if you want the console shown, and -1 if you want it hidden.
  125.         # after idle tixConsoleEvalAppend $tcl_interactive
  126.         set tcl_interactive 1
  127.         if {$env(TIX_CONSOLE) == "-1"} {after idle catch {console hide}}
  128.     } else {
  129.         # To invoke this,  simply set the environment variable TIX_CONSOLE
  130.         # to 1 if you want the console shown, and -1 if you want it hidden.
  131.         # after idle tixConsoleEvalAppend $tcl_interactive
  132.         if {[info exists env(TIX_CONSOLE)] && $env(TIX_CONSOLE) == "-1"} {
  133.         # You *must* use after idle
  134.         after idle catch {console hide}
  135.         }
  136.     }
  137.     }
  138.  
  139.     # In the past, the interactive initialization file was inconsistent,
  140.     # and on Windows, $env(HOME) is undefined or most users don't even
  141.     # know where there HOME is (Profiles\User\Application Data\)!
  142.     # So a site wide initialization file tixwishrc.tcl is now used,
  143.     # which must be in the same directory as the executable. To restore
  144.     # the past behaviour, simply add the following line to that file:
  145.     #  if {[file isfile [set file ~/.tixwishrc]]} {source $file}
  146.  
  147.     set bindir [file dirname [info nameofexe]]
  148.     if {[file isfile [set file [file join $bindir tixwishrc.tcl]]]} {
  149.     global tcl_rcFileName
  150.     set tcl_rcFileName $file
  151.     }
  152.  
  153.     rename __tixError ""
  154.     rename __tixInit ""
  155. }
  156.  
  157. # tixWidgetClassEx --
  158. #
  159. #       This procedure is similar to tixWidgetClass, except it
  160. #       performs a [subst] on the class declaration before evaluating
  161. #       it. This gives us a chance to specify platform-specific widget
  162. #       default without using a lot of ugly double quotes.
  163. #
  164. #       The use of subst'able entries in the class declaration should
  165. #       be restrained to widget default values only to avoid producing
  166. #       unreadable code.
  167. #
  168. # Arguments:
  169. # name -    The name of the class to declare.
  170. # classDecl -    Various declarations about the class. See documentation
  171. #               of tixWidgetClass for details.
  172.  
  173. proc tixWidgetClassEx {name classDecl} {
  174.     tixWidgetClass $name [uplevel [list subst $classDecl]]
  175. }
  176.  
  177.  
  178.